home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / Perl Mode / perlMenu.tcl < prev    next >
Encoding:
Text File  |  1999-03-04  |  10.5 KB  |  382 lines  |  [TEXT/ALFA]
  1. # ◊◊◊◊ file loading dummy ◊◊◊◊ #
  2. proc perlMenu.tcl {} {}
  3.  
  4. #############################################################################
  5. # ◊◊◊◊ Build the perl menu ◊◊◊◊ #
  6. #            
  7.  
  8. menu::buildProc perlMenu menu::buildPerl
  9. menu::buildProc generalOptions menu::buildgeneralOptions
  10. menu::buildProc filterOptions menu::buildfilterOptions
  11. menu::buildProc perlFilterMenu rebuildFilterMenu
  12.  
  13. set perlFilterMenu "textFilters"
  14.  
  15. proc menu::buildPerl {} {
  16.     global PerlmodeVars perlFilterMenu perlMenu 
  17.     set ma {
  18.         "/'<Umacperl"
  19.         {Menu -m -n "tellMacperl..." -p perlTellProc {
  20.            "/O<UOpen This File"
  21.            "Save As Droplet"
  22.            "Save As Runtime"
  23.            "Save As CGI"
  24.             "(-"
  25.            "Get Output Window"
  26.            "Close Output Window"
  27.            "Quit"
  28.            }
  29.         } 
  30.         {Menu -m -n "Quick Save As..." -p perlSaveProc {
  31.            "Droplet"
  32.            "Runtime"
  33.            "CGI"
  34.            }
  35.         } 
  36.         {Menu -m -n help -p perlHelpProc {
  37.             "MacPerl Mode"
  38.             "Mac Specifics"
  39.             "Perl4 Manual"
  40.             "Perl5 Manual"
  41.         }}
  42.         "(-"
  43.         "runTheSelection"
  44.         "/R<UrunTheBuffer"
  45.         "/R<B<OsaveAndRun"
  46.         "runAFile"
  47.         "(-"
  48.     }
  49.     lappend ma [list Menu -n $perlFilterMenu {}] \
  50.       "selectBufferAsFilter" "selectFileAsFilter"
  51.     lappend ma "/F<UrepeatLastFilter"
  52. #    We enable this menu item without checking for a valid last filter; we'll 
  53. #    disable it after 'menu::buildSome perlMenu' is called. (RBC 02-MAR-1999)    
  54.     lappend ma "(-" \
  55.       [list Menu -n generalOptions {}] \
  56.       [list Menu -n filterOptions {}]
  57.  
  58.     return [list build $ma -1 \
  59.       {generalOptions filterOptions perlFilterMenu} $perlMenu]
  60. }
  61.  
  62. # General Perl-menu options menu
  63. #
  64. proc menu::buildgeneralOptions {} {
  65.     global PerlmodeVars
  66.     foreach i {"retrieveOutput" "autoSwitch" "promptForArgs" "useDebugger"} {
  67.         if [set PerlmodeVars(perl$i)] {
  68.             lappend ma "!•$i"
  69.         } else {
  70.             lappend ma $i
  71.         }
  72.     }
  73.     return [list build $ma]
  74. }
  75.  
  76. # Text Filter options menu
  77. #
  78. proc menu::buildfilterOptions {} {
  79.     global PerlmodeVars
  80.     Menu -n filterOptions {
  81.         "applyToBuffer"
  82.         "overwriteSelection"
  83.         "(-"
  84.         "rebuildFilterMenu"
  85.     }    
  86.     markMenuItem filterOptions overwriteSelection $PerlmodeVars(perloverwriteSelection)
  87.     markMenuItem filterOptions applyToBuffer $PerlmodeVars(perlapplyToBuffer)
  88. }
  89.  
  90. #############################################################################
  91. # ◊◊◊◊ filter menu builder ◊◊◊◊ #
  92. #  Build a submenu of "preattached" Perl filters using the names of the 
  93. #  scripts in the Text Filters directory.  Called whenever Text Filters
  94. # folder is reassigned.
  95. #
  96. proc rebuildFilterMenu {{args}} {
  97.     global PerlmodeVars perlFilters perlFilterMenu perlFilterPath
  98.     global PerlmodeVars $perlFilterMenu
  99.     
  100.     eval [menu::buildHierarchy [list $PerlmodeVars(perlFilterPath)] $perlFilterMenu textFiltersProc perlFilters]
  101. }
  102.  
  103. menu::buildSome perlMenu
  104. if {$PerlmodeVars(perlPrevScript) == {} || $PerlmodeVars(perlPrevScript) == {*startup*}} {
  105.         enableMenuItem $perlMenu repeatLastFilter 0 
  106.     } 
  107. # After building menu, disable "repeatLastFilter" command since there isn't a filter
  108. # yet. The if statement should always be true on the initial build. (RBC 02-MAR-1999) 
  109.  
  110.  
  111. # ◊◊◊◊ var & menu updater ◊◊◊◊ #
  112. # ShadowPerl sets the global PerlmodeVars vars when the mode vars are modified and
  113. # keeps the menu checkmarked correctly.
  114. #
  115. proc shadowPerl {name} {
  116.     global PerlmodeVars HOME perlMenu
  117.     switch $name {
  118.         "perluseDebugger"    {
  119.             markMenuItem generalOptions useDebugger $PerlmodeVars(perluseDebugger)
  120.          }
  121.         "perloverwriteSelection"    {
  122.             markMenuItem filterOptions overwriteSelection $PerlmodeVars(perloverwriteSelection)
  123.          }
  124.         "perlapplyToBuffer"    {
  125.             markMenuItem filterOptions applyToBuffer $PerlmodeVars(perlapplyToBuffer)
  126.          }
  127.         "perlretrieveOutput"    {
  128.             markMenuItem generalOptions retrieveOutput $PerlmodeVars(perlretrieveOutput) 
  129.         }
  130.         "perlautoSwitch" {    
  131.             markMenuItem generalOptions autoSwitch $PerlmodeVars(perlautoSwitch) 
  132.         }
  133.         "perlpromptForArgs" {    
  134.             markMenuItem generalOptions promptForArgs $PerlmodeVars(perlpromptForArgs) 
  135.         }
  136.         "perlVersion" {    
  137.             set modeCode "perl${perlVersion}.tcl"
  138.             if {[catch "$modeCode"]} {
  139.                 alertnote "Couldn't load the Perl-mode colorization file \"$modeCode\".  Contact the maintainer."
  140.             }
  141.         }
  142.         "perlLastFilter" {    
  143.             # Don't allow perlPrevScript to be changed from the flags menu
  144.             if {$PerlmodeVars(perlPrevScript) == "*startup*"} {
  145.                 set PerlmodeVars(perlPrevScript) $perlLastFilter
  146.                 enableMenuItem $perlMenu repeatLastFilter 1
  147.             } else {
  148.                 set perlLastFilter $PerlmodeVars(perlPrevScript) 
  149.             }
  150.         }
  151.     }
  152. }
  153.  
  154. #############################################################################
  155. # ◊◊◊◊ •Menu commands ◊◊◊◊ #
  156. #############################################################################
  157.  
  158. ###########################################################################
  159. #
  160. proc perlHelpProc {menu item} {
  161.     global PerlmodeVars HOME
  162.     switch $item {
  163.         "MacPerl Mode"    {
  164.                 if {[catch {openFileQuietly "$HOME:Help:MacPerl Help"}]} {
  165.                     alertnote "File not found:\r$HOME:Help:MacPerl Help"
  166.                 }
  167.             }
  168.         "Mac Specifics"    {
  169.                 if {[catch {openFileQuietly "$HOME:Help:MacPerl.Specifics"}]} {
  170.                     alertnote "File not found:\r$HOME:Help:MacPerl.Specifics"
  171.                 }
  172.             }
  173.         "Perl4 Manual"    {
  174.                 if {[catch {openFileQuietly "$HOME:Help:Perl Commands"}]} {
  175.                     alertnote "File not found:\r$HOME:Help:Perl Commands"
  176.                 }
  177.             }
  178.         "Perl5 Manual"    {
  179.                 catch {editMark "$HOME:Help:Perl Commands" Perl5 -r}
  180.             }
  181.     }
  182. }
  183.  
  184. ############################################################################
  185. # ◊◊◊◊ toggle flags ◊◊◊◊ #
  186. # Toggle the perl menu flags
  187. #
  188. proc retrieveOutput {} {
  189.     perlFlip perlretrieveOutput
  190. }
  191.  
  192. proc useDebugger {} {
  193.     perlFlip perluseDebugger
  194. }
  195.  
  196. proc autoSwitch {} {
  197.     perlFlip perlautoSwitch
  198. }
  199.  
  200. proc perlFlip {var} {
  201.     global PerlmodeVars
  202.     set PerlmodeVars($var) [expr [set PerlmodeVars($var)] ? 0 : 1]
  203.     synchroniseModeVar $var $PerlmodeVars($var)
  204.     shadowPerl $var
  205. }
  206.  
  207. proc overwriteSelection {} {
  208.     perlFlip perloverwriteSelection
  209. }
  210.  
  211. proc applyToBuffer {} {
  212.     perlFlip perlapplyToBuffer
  213. }
  214.  
  215. proc promptForArgs {} {
  216.     perlFlip perlpromptForArgs
  217. }
  218.  
  219. #############################################################################
  220. # ◊◊◊◊ Switch to MacPerl ◊◊◊◊ #
  221. # 
  222. proc macperl {} {
  223.     app::launchFore McPL
  224. }
  225.  
  226. #############################################################################
  227. # ◊◊◊◊ other MacPerl interactions ◊◊◊◊ #
  228. # Interact with MacPerl in some other way besides executing a script
  229. #
  230. #DTH: note addition of two lines for auto-save
  231. proc perlTellProc {menu name} {
  232.     switch -exact $name {
  233.     "Open This File"        { openInMacperl }
  234.     
  235.     "Save As Droplet"        { saveThruMacperl "droplet" }
  236.     
  237.     "Save As Runtime"        { saveThruMacperl "runtime" }
  238.     
  239.     "Save As CGI"            { saveThruMacperl "cgi" }
  240.     
  241.     "Get Output Window"        { openPerlOutput }
  242.     
  243.     "Close Output Window"    { sendCloseWinName MacPerl $perlName ;
  244.                               sendCloseWinName MacPerl "Perl Debug" }
  245.                             
  246.     "Quit"                    { quitMacperl }
  247.     }
  248. }
  249.  
  250. proc perlSaveProc {menu name} {
  251.     switch -exact $name {
  252.     "Droplet"    { saveThruMacperl "auto-droplet" }
  253.     
  254.     "Runtime"    { saveThruMacperl "auto-runtime" }
  255.  
  256.     "CGI"        { saveThruMacperl "auto-cgi" }
  257.     }
  258. }
  259.  
  260. #############################################################################
  261. # ◊◊◊◊ open curr file in MacPerl ◊◊◊◊ #
  262. # Open the current file under MacPerl.  This used to useful for saving files 
  263. # as droplets or runtime scripts.  Maybe it's still useful for something...?
  264. #
  265. proc openInMacperl {} {
  266.     if {[winDirty]} {
  267.         case [askyesno -c "Save '[lindex [winNames] 0]'?"] in {
  268.             "yes" {save}
  269.             "no" {}
  270.             "cancel" {return}
  271.         }
  272.     }
  273.     set name [app::launchFore McPL]
  274.     sendOpenEvent -n [file tail $name] [win::Current]
  275. }
  276.  
  277. #############################################################################
  278. # ◊◊◊◊ save as droplet or runtime ◊◊◊◊ #
  279. # Save the script in the current window as a MacPerl droplet or 
  280. # runtime script.  
  281. #
  282. proc saveThruMacperl {type} {
  283.     global PerlmodeVars ALPHA
  284.  
  285.     set name [file tail [app::launchBack McPL]]
  286.     getWinInfo arr
  287.     if {$arr(dirty) == 1} {
  288.         case [askyesno -c "Save '[lindex [winNames] 0]' source file also?"] in {
  289.             "yes" {save}
  290.             "no" {}
  291.             "cancel" {return}
  292.         }
  293.     }
  294.     #DTH note the following "if" block which replaced what is in the new "else" block
  295.     set myName [lindex [winNames -f] 0]
  296.     if {$type == "auto-droplet" || $type == "auto-runtime"} {
  297.         if {[file extension $myName] == ".pl"} {
  298.             set destfile [AEFilename [file rootname $myName]]
  299.         } else {
  300.             set destfile [AEFilename [file rootname $myName]]
  301.         }
  302.     } elseif {$type == "auto-cgi"} {
  303.         set destfile [AEFilename "[file rootname $myName].cgi"]
  304.     } else {
  305.         set destfile [AEFilename [putfile {Save droplet as} [lindex [winNames] 0]]]
  306.     }
  307.  
  308.     set script [curlyq [getText [minPos] [maxPos]]]
  309.     #DTH note addition of "auto-xxx" in two lines below
  310.     if {$type == "droplet" || $type == "auto-droplet"} {
  311.         set saveType "SCPT"
  312.     } elseif {$type == "runtime" || $type == "auto-runtime"} {
  313.         set saveType "MrP7"
  314.     } elseif {$type == "cgi" || $type == "auto-cgi"} {
  315.         set saveType "'WWWΩ'"
  316.     } elseif {$type == "text"} {
  317.         set saveType "TEXT"
  318.     }
  319.     
  320.     set err [catch {eval "AEBuild -t 36000 -r \"$name\"" core save {----} [list $script] {dest:} [list $destfile] {fltp:} $saveType } reply ]
  321.     if {$err} { message "AEBuild error code $err in saveThruMacperl" }
  322.     
  323. # The following lines could be used to tell MacPerl to take the script file 
  324. # from an existing disk file and then re-save it in the desired form.
  325. #
  326. #    set srcfile "\[ [AEFilename [win::Current]] \]"
  327. #    set reply [eval "AEBuild -t 36000 -r \"$name\"" core save {----} [list $srcfile] {dest:} [list $destfile] {fltp:} $saveType ]
  328. #
  329. }
  330.  
  331. #############################################################################
  332. # ◊◊◊◊ Quit a running MacPerl app ◊◊◊◊ #
  333. # 
  334. proc quitMacperl {} {
  335.     foreach proc [processes] {
  336.         set sig [lindex $proc 1]
  337.         if {$sig == "McPL"} {
  338.             sendQuitEvent [lindex $proc 0]
  339.             # switchTo is necessary to keep MacPerl from blinking
  340.             switchTo [lindex $proc 0]    
  341.         }
  342.     }
  343. }
  344.  
  345. #############################################################################
  346. # ◊◊◊◊ run something via MacPerl ◊◊◊◊ #
  347. # (No special arrangements are made to provide input or capture the output)
  348. # 
  349. proc runTheSelection {} {
  350.     global PerlmodeVars scriptFile scriptStart
  351.     set scriptFile [win::Current]
  352.     set scriptStart [lindex [posToRowCol [getPos]] 0]
  353.     perlExecuteScript [getSelect]
  354. }
  355.  
  356. proc runTheBuffer {} {
  357.     global PerlmodeVars scriptFile scriptStart
  358.     set scriptFile [win::Current]
  359.     set scriptStart 1
  360.     perlExecuteScript [getText [minPos] [maxPos]]
  361. }
  362.  
  363. proc runAFile {} {
  364.     global PerlmodeVars scriptFile scriptStart
  365.     if {! [catch {getfile "Select a Perl script"} path]} {
  366.         set scriptFile $path
  367.         set scriptStart 1
  368.         perlExecuteFile $path
  369.     }
  370. }
  371.  
  372. proc saveAndRun {} {
  373.     global PerlmodeVars scriptFile scriptStart
  374.     save
  375.     set path [win::Current]   
  376.     set scriptFile $path
  377.     set scriptStart 1
  378.     perlExecuteFile $path
  379. }
  380.  
  381.  
  382.